home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt0187a.arc / FREEDMAN.ARC / PAL1.BAS next >
BASIC Source File  |  1980-01-01  |  12KB  |  291 lines
  1. 10 REM DEFINE VARIABLEs
  2. 20 CLEAR
  3. 30 DEFINT C,F,H,N,O,T,W,X,Y,Z,L
  4. 40 DIM F(39,79),N2(24)
  5. 50 DEFSTR A,D,P
  6. 60 DIM A(15),P(25),N(12),N1(12)
  7. 70 X$=CHR$(32):A=STRING$(50," "):AT=A+" "
  8. 80 C=0:X=0:Y=0:Z=0:S$=""
  9. 90 REM ***********************************************************
  10. 100 REM ***    INFORMATION ABOUT PALASM SPECEFICATION           ***
  11. 110 REM ***********************************************************
  12. 115 PRINT"(c) Copyright 1983 Monolithic Memories Inc. All Rights Reserved"
  13. 116 PRINT
  14. 120 PRINT TAB(13)"PALASM-20/24 in Basic":PRINT
  15. 130 PRINT TAB(11)"Revision level 1.2"
  16. 140 PRINT TAB(11)"07/15/81 D. Jones"
  17. 150 PRINT TAB(11)"06/22/83 U. Mueller & C.B. Lee"
  18. 160 PRINT
  19. 170 PRINT"Note: When using the 20X- Pals in the series 24"
  20. 180 PRINT"family, the XOR operator ':+:' should start a new"
  21. 190 PRINT"line.  Thus:  /Q1 := A*B + C*D :+: E*F + G*H"
  22. 200 PRINT"is an error":PRINT
  23. 210 PRINT"It should read:"
  24. 220 PRINT"      /Q1 :=  A*B + C*D     or     /Q1 :=  A*B"
  25. 230 PRINT"          :+: E*F + G*H                 +  C*D"
  26. 240 PRINT"                                       :+: E*F"
  27. 250 PRINT"The second format is recommended        +  G*H"
  28. 260 PRINT"for ease of reading and commenting."
  29. 270 PRINT"Note also a space is required before and after"
  30. 280 PRINT"the '+' in the first format."
  31. 285 PRINT
  32. 290 PRINT"Press a key to continue..."
  33. 300 DUMMY$=INKEY$:IF DUMMY$="" THEN 300
  34. 310 FOR I=1 TO 23:PRINT:NEXT
  35. 320 PRINT"What is your input file name ?";
  36. 330 LINE INPUT F$:IF F$="" THEN 120:REM * GET FILENAME *
  37. 340 X=1:OPEN "I",1,F$:REM * X=NUMBER OF LINES READ IN *
  38. 350 FOR I=1 TO 10:PRINT:NEXT
  39. 360 PRINT"           ASSEMBLING...PLEASE WAIT !!!"
  40. 370 PRINT:PRINT
  41. 380 REM **********************************************************
  42. 390 REM ***    VERIFY PART NUMBER AND GET TYPE                 ***
  43. 400 REM **********************************************************
  44. 410 LINE INPUT #1,A:TY=0
  45. 415 IF A="" THEN 410
  46. 420 X=INSTR(A,"PAL")
  47. 430 OT$=MID$(A,X+5,1):P=MID$(A,X+6,2):NO=VAL(P)
  48. 440 PN=MID$(A,X,8):IF RIGHT$(PN,1)=" " THEN PN=LEFT$(PN,7)
  49. 450 P=LEFT$(PN,3):IF P<>"PAL" THEN GOTO 590 ELSE P=MID$(PN,4,5)
  50. 460 OPEN "I",2,"PALTABLE.DAT"
  51. 465 INPUT #2,TYPE$
  52. 470 IF TYPE$<>P THEN LINE INPUT #2,DUMMY$:GOTO 465
  53. 475 INPUT #2,TY,XM,YM,S,FCODE
  54. 485 FOR I=1 TO S
  55. 495 INPUT #2,N2(I)
  56. 505 NEXT I
  57. 515 FOR I=0 TO S-12
  58. 525 INPUT #2,N(I),N1(I)
  59. 535 NEXT I
  60. 540 FOR I=1 TO INT((S/2)-1)
  61. 545 INPUT #2,IX(I)
  62. 550 NEXT I
  63. 555 CLOSE 2
  64. 590 IF TY=0 THEN GOSUB 2020:PRINT"INVALID PART NUMBER":END
  65. 600 PRINT"PART NUMBER ... OK !!!"
  66. 605 GOSUB 3000
  67. 610 REM ************************************************************
  68. 620 REM ***     VERIFY PIN LIST                                  ***
  69. 630 REM ************************************************************
  70. 640 FOR I=1 TO 4:LINE INPUT #1,A:NEXT I
  71. 650 Y=1
  72. 660 A=A+" ":C=LEN(A):FOR X=1 TO C
  73. 670 P=MID$(A,X,1):IF P<>" " THEN P(Y)=P(Y)+P
  74. 680 IF P=" " AND P(Y)<>"" THEN Y=Y+1
  75. 690 NEXT:IF Y=S+2 THEN 710 ELSE IF Y<S+2 THEN LINE INPUT #1,A:GOTO 660
  76. 700 GOSUB 2020:PRINT"INVALID PIN LIST":END
  77. 710 W=(S+1)/2:IF P(W)="GND" THEN 730
  78. 720 PRINT"ERROR CORRECTED... PIN";W;" IS NOW `GND'":P(W)="GND"
  79. 730 W=S+1:IF P(W)="VCC" THEN 750
  80. 740 PRINT"ERROR CORRECTED... PIN";W;" IS NOW `VCC'":P(W)="VCC"
  81. 750 PRINT"PIN LIST ...... OK !!!"
  82. 780 REM ***********************************************************
  83. 790 REM ***      FIND OUTPUT IN EQUATION                        ***
  84. 800 REM ***********************************************************
  85. 810 OU=0:IF TY>4 AND TY<9 THEN NO=8
  86. 820 IF TY=16 THEN NO=8 ELSE IF TY=15 THEN NO=10
  87. 830 LINE INPUT #1,A:IF EOF(1) THEN CLOSE:GOTO 2380
  88. 840 IF LEFT$(A,1)=";" OR INSTR(A,"=")=0 THEN 830
  89. 850 ZZ=INSTR(A,";"):IF ZZ<>0 THEN A=LEFT$(A,ZZ-1)
  90. 860 IF INSTR(A," ")=0 THEN 880
  91. 870 ZZ=INSTR(A," "):A=LEFT$(A,ZZ-1)+RIGHT$(A,LEN(A)-ZZ):GOTO 860
  92. 880 AA=A:FC=0:FS=0:FR=0:AT="":DL=")/ "
  93. 890 CE=INSTR(A,"="):IF CE=0 THEN 830
  94. 900 OU=OU+1:IF OU>NO THEN 1650
  95. 910 AL=LEFT$(A,CE-1):CT=LEN(A):CN=CE
  96. 920 CN=CN-1:IF CN=0 THEN GOTO 950
  97. 930 P=MID$(A,CN,1):IF P=" " THEN 920 ELSE IF P=":" THEN FR=1:GOTO 920
  98. 940 P=MID$(A,CN,1):IF INSTR(DL,P)=0 THEN AT=P+AT:CN=CN-1:IF CN<>0 THEN 940
  99. 950 IF INSTR(AT," ")<>0 THEN AT=LEFT$(AT,LEN(AT)-1):GOTO 950
  100. 960 FOR Z=12 TO S:IF AT=P(Z) OR P(Z)=("/"+AT) THEN GOSUB 1910:GOTO 990
  101. 970 IF AT=("/"+P(Z)) THEN GOSUB 1910:GOTO 990 ELSE NEXT
  102. 980 GOSUB 2020:PRINT"OUTPUT UNDEFINED BY PIN LIST":GOTO 1680
  103. 990 IF Y=0 THEN GOSUB 2020:PRINT"INVALID OUTPUT PIN":GOTO 1680
  104. 1000 IF Y>100 THEN FR=1:Y=Y-100 ELSE IF Y<0 THEN FC=1:Y=-Y ELSE FS=1
  105. 1010 Y=Y-1:PRINT"ASSEMBLING OUTPUT:  ";P(Z);" ;PL =";Y;"     "
  106. 1030 Y1=Y+NP:GOSUB 1720
  107. 1040 IF (FS=1 OR FR=1) AND INSTR(AL,")")<>0 THEN 1070
  108. 1050 IF FC=1 AND INSTR(AL,")")=0 THEN Y=Y+1:CN=CE+1:GOSUB 1720:GOTO 1350
  109. 1060 IF FC=1 THEN 1120 ELSE CN=CE+1:GOTO 1350
  110. 1070 GOSUB 2020:PRINT"EQUATION INVALID FOR THIS OUTPUT TYPE"
  111. 1080 PRINT"-->";A;" PIN =";ZO:END
  112. 1090 REM **********************************************************
  113. 1100 REM ***    THREE-STATE ENABLE ONLY                         ***
  114. 1110 REM **********************************************************
  115. 1120 IF INSTR(AL,"VCC")<>0 THEN CN=CE+1:Y=Y+1:GOSUB 1720:GOTO 1350
  116. 1130 CN=INSTR(AL,"("):CT=INSTR(AL,")"):IF CN=0 OR CT=0 THEN 1070
  117. 1140 A=AL:CN=CN+1:CT=CT-1
  118. 1150 IF INSTR(A,"+")=0 THEN 1170
  119. 1160 GOSUB 2020:PRINT"INVALID CONDITIONAL STATEMENT":PRINT"-->";A:END
  120. 1170 DL="(:)+*":AT=""
  121. 1180 IF CN>CT THEN GOTO 1220
  122. 1190 P=MID$(A,CN,1):IF P=" " THEN CN=CN+1:GOTO 1180
  123. 1200 IF INSTR(DL,P)=0 THEN AT=AT+P:IF CN<>CT THEN CN=CN+1:GOTO 1180
  124. 1210 GOSUB 1560:GOTO 1170
  125. 1220 Y=Y+1:A=AA:CN=CE+1:CT=LEN(A)
  126. 1230 GOSUB 1720
  127. 1240 GOTO 1350
  128. 1250 REM **********************************************************
  129. 1260 REM ***    INPUT PROCESSING FOR SIMPLE OUTPUTS             ***
  130. 1270 REM **********************************************************
  131. 1280 LINE INPUT #1,A:IF EOF(1) THEN CLOSE:GOTO 2380
  132. 1290 IF INSTR(A,"DESCRIPTION")<>0 THEN 2380
  133. 1300 IF INSTR(A,"FUNCTION TABLE")<>0 THEN 2380
  134. 1310 ZZ=INSTR(A,";"):IF ZZ<>0 THEN A=LEFT$(A,ZZ-1)
  135. 1320 IF INSTR(A," ")=0 THEN 1340
  136. 1330 ZZ=INSTR(A," "):A=LEFT$(A,ZZ-1)+RIGHT$(A,LEN(A)-ZZ):GOTO 1320
  137. 1340 CT=LEN(A):CN=1:IF INSTR(A,"=")<>0 THEN 880
  138. 1350 AT="":P=MID$(A,CN,1):IF P<>"+" THEN 1370
  139. 1360 GOSUB 1560:Y=Y+1:GOSUB 1720:GOTO 1350
  140. 1370 IF P<>":" THEN 1390 ELSE IF MID$(A,CN,3)<>":+:" THEN 1390
  141. 1380 GOSUB 1560:CN=CN+2:Y=2*INT((Y+2)/2):GOSUB 1720:GOTO 1350
  142. 1390 IF P="*" THEN GOSUB 1560:GOTO 1350
  143. 1400 IF TY=7 AND (P="(" OR P=")") THEN 2040
  144. 1410 IF P="(" OR P=")" OR (P=":" AND TY<>15) THEN 1070
  145. 1420 CO=INSTR(CN,A,"+")
  146. 1430 CA=INSTR(CN,A,"*")
  147. 1440 IF CO>0 AND CA>0 AND CA>CO THEN CD=CO:GOTO 1480
  148. 1450 IF CO>0 AND CA=0 THEN CD=CO:GOTO 1480
  149. 1460 CD=CA
  150. 1470 IF CD=0 THEN CD=CT+1
  151. 1480 AT=MID$(A,CN,CD-CN):GOSUB 1560:CN=CD:IF CN=CO THEN Y=Y+1:GOSUB 1720
  152. 1490 CN=CD+1:IF CD>CT THEN 1280
  153. 1500 GOTO 1350
  154. 1510 GOSUB 2020:PRINT"EXCESSIVE NUMBER OF TERMS FOR THIS OUTPUT"
  155. 1520 PRINT"MAXIMUM NUMBER OF TERMS IS";NP;"FOR OUTPUT PIN";ZO:END
  156. 1530 REM **********************************************************
  157. 1540 REM ***   INPUT MATCH AND SET FUSE                         ***
  158. 1550 REM **********************************************************
  159. 1560 IF AT="" THEN CN=CN+1:RETURN
  160. 1570 FOR Z=1 TO S+1
  161. 1580 IF AT=P(Z) THEN GOSUB 1670:X=X-1:GOTO 1640
  162. 1590 IF AT="/"+P(Z) THEN GOSUB 1670:GOTO 1640
  163. 1600 IF ASC(P(Z))=47 AND AT=MID$(P(Z),2) THEN GOSUB 1670:GOTO 1640
  164. 1610 NEXT
  165. 1620 IF LEFT$(AT,5)="CARRY" THEN 1280
  166. 1630 GOSUB 2020:PRINT"INPUT UNDEFINED BY PIN LIST":GOTO 1680
  167. 1640 F(X,Y)=0:NB=NB-1:CN=CN+1:RETURN
  168. 1650 GOSUB 2020:PRINT"EXCESSIVE NUMBER OF EQUATIONS GIVEN."
  169. 1660 PRINT"ONLY THE FIRST";NO;" WILL BE ASSEMBLED.":GOTO 2380
  170. 1670 X=N2(Z):IF X<>0 THEN RETURN ELSE GOSUB 2020:PRINT"INVALID INPUT PIN"
  171. 1680 PRINT"-->";A;"  >";AT;"<":END
  172. 1690 REM **********************************************************
  173. 1700 REM ***      INITZL PROD LINE WITH BLOWN FUSES             ***
  174. 1710 REM **********************************************************
  175. 1720 IF Y>Y1 THEN 1510
  176. 1730 FOR I=0 TO XM:IF F(I,Y)=0 THEN F(I,Y)=1:NB=NB+1
  177. 1740 NEXT:RETURN
  178. 1910 Y=N(Z-12):NP=N1(Z-12):RETURN
  179. 2020 PRINT"*** ERROR ***":RETURN
  180. 2030 REM **********************************************************
  181. 2040 REM ***       FOR 16A4 AND 16X4 PALS ONLY                  ***
  182. 2050 REM **********************************************************
  183. 2060 IF P=":"THEN A1=MID$(A,CN,3)ELSE GOTO 2100
  184. 2070 IF A1=":+:"THEN Y=4*(INT((Y+4)/4)):GOSUB 1720:CN=CN+3:GOTO 1390
  185. 2080 IF A1=":*:"THEN GOSUB 2020:PRINT"':*:' IS USED INSIDE PARENTHESES ONLY":END
  186. 2090 GOSUB 2020:PRINT">";P;"< IS INVALID AS USED IN:":PRINT"-->";A:END
  187. 2100 N8=CN:N9=INSTR(CN,A,")"):IF N9=0 THEN 2090
  188. 2110 A1=MID$(A,N8+1,N9-N8-1)
  189. 2120 N=VAL(RIGHT$(A1,1)):IF N<0 OR N>3 THEN 2130 ELSE 2140
  190. 2130 GOSUB 2020:PRINT"INVALID EXPRESSION '";A1;"'":END
  191. 2140 X=N*4+8
  192. 2150 N0=LEN(A1)-1:IF N0>6 THEN 2130
  193. 2160 ON N0 GOTO 2170,2190,2210,2220,2240,2290
  194. 2170 C=2:GOSUB 2340:IF MID$(A1,1,1)="A"THEN C=3 ELSE C=0
  195. 2180 GOSUB 2340:GOTO 2330
  196. 2190 C=1:GOSUB 2340:IF MID$(A1,2,1)="A"THEN C=0 ELSE C=3
  197. 2200 GOSUB 2340:GOTO 2330
  198. 2210 AT=A1:GOTO 1630
  199. 2220 C=2:GOSUB 2340:IF INSTR(A1,"+")<>0 THEN 2330
  200. 2230 C=0:GOSUB 2340:C=3:GOSUB 2340:GOTO 2330
  201. 2240 IF INSTR(A1,"+B")<>0 THEN C=0:GOSUB 2340:GOTO 2330
  202. 2250 IF INSTR(A1,"+/")<>0 THEN C=3:GOSUB 2340:GOTO 2330
  203. 2260 C=1:GOSUB 2340:C=2:GOSUB 2340
  204. 2270 IF INSTR(A1,"*B")<>0 THEN C=0:GOSUB 2340:GOTO 2330
  205. 2280 C=3:GOSUB 2340:GOTO 2330
  206. 2290 IF INSTR(A1,"+/")<>0 THEN C=1:GOSUB 2340:GOTO 2330
  207. 2300 IF INSTR(A1,"+:")<>0 THEN C=1:GOSUB 2340:C=2:GOSUB 2340:GOTO 2330
  208. 2310 C=0:GOSUB 2340:C=3:GOSUB 2340
  209. 2320 IF INSTR(A1,"*/")<>0 THEN C=1:GOSUB 2340:GOTO 2330
  210. 2330 CN=N9+1:GOTO 1350
  211. 2340 F(X+C,Y)=0:NB=NB-1:RETURN
  212. 2350 REM ****************************************************
  213. 2360 REM ***     SAVE VARIABLES  &  CHAIN NEXT PRG.       ***
  214. 2370 REM ****************************************************
  215. 2380 CLOSE
  216. 2382 FOR I=12 TO S
  217. 2384 IF N(I-12)<0 THEN N(I-12)=-N(I-12)
  218. 2386 IF N(I-12)>100 THEN N(I-12)=N(I-12)-100
  219. 2387 IF N(I-12)=0 THEN 2389
  220. 2388 N(I-12)=(N(I-12)-1)+N1(I-12)-1
  221. 2389 NEXT I
  222. 2390 OPEN "O",1,"PALTEMP.DAT"
  223. 2400 WRITE #1,TY,FCODE,TYPE$
  224. 2410 WRITE #1,NB,S,XM,YM,F$
  225. 2420 WRITE #1,OT$
  226. 2430 FOR J=0 TO YM
  227. 2440 A=""
  228. 2450 FOR I=0 TO XM STEP 2
  229. 2460 A=A+RIGHT$(STR$(F(I,J)),1)+RIGHT$(STR$(F(I+1,J)),1)
  230. 2470 NEXT I
  231. 2480 PRINT #1,A
  232. 2490 PRINT J;" ";CHR$(13);
  233. 2500 NEXT J
  234. 2510 FOR I=0 TO S-12
  235. 2520 WRITE #1,N(I),N1(I)
  236. 2530 NEXT I
  237. 2532 FOR I=1 TO S+1
  238. 2534 WRITE #1,P(I)
  239. 2536 NEXT I
  240. 2540 CLOSE
  241. 2550 RUN "PAL2"
  242. 2560 END
  243. 3000 C=0:FOR L1=1 TO INT((S/2)-1)
  244. 3010 RESTORE
  245. 3020 FOR L2=1 TO IX(L1)-1
  246. 3030 READ IN,IN,IN,IN,IN,IN,IN,IN
  247. 3040 NEXT L2
  248. 3050 FOR L2=1 TO 8
  249. 3060 READ IN
  250. 3070 ON IN GOSUB 3150,3200,3250,3300,3350,3400,3450
  251. 3075 C=C+1
  252. 3080 NEXT L2
  253. 3090 NEXT L1
  254. 3100 RETURN
  255. 3150 RETURN
  256. 3200 FOR I=0 TO XM
  257. 3210 F(I,C)=3
  258. 3220 NEXT I
  259. 3230 RETURN
  260. 3250 FOR I=0 TO XM
  261. 3260 F(I,C)=2
  262. 3270 NEXT I
  263. 3280 RETURN
  264. 3300 FOR I=6 TO XM-5 STEP 4
  265. 3310 F(I,C)=3:F(I+1,C)=3
  266. 3320 NEXT I
  267. 3330 RETURN
  268. 3350 FOR I=10 TO XM-9 STEP 4
  269. 3360 F(I,C)=3:F(I+1,C)=3
  270. 3370 NEXT I
  271. 3380 RETURN
  272. 3400 FOR I=14 TO XM-13 STEP 4
  273. 3410 F(I,C)=3:F(I+1,C)=3
  274. 3420 NEXT I
  275. 3430 RETURN
  276. 3450 FOR I=18 TO XM-17 STEP 4
  277. 3460 F(I,C)=3:F(I+1,C)=3
  278. 3470 NEXT I
  279. 3480 RETURN
  280. 5000 DATA 1,1,1,1,1,1,1,1
  281. 5010 DATA 2,2,2,2,2,2,2,2
  282. 5020 DATA 3,3,3,3,3,3,3,3
  283. 5030 DATA 4,4,3,3,3,3,3,3
  284. 5040 DATA 5,5,3,3,3,3,3,3
  285. 5050 DATA 5,5,5,5,3,3,3,3
  286. 5060 DATA 6,6,6,6,3,3,3,3
  287. 5070 DATA 6,6,3,3,3,3,3,3
  288. 5080 DATA 7,7,7,7,7,7,3,3
  289. 5090 DATA 7,7,7,7,3,3,3,3
  290. 5100 DATA 1,1,1,1,3,3,3,3
  291. A